home *** CD-ROM | disk | FTP | other *** search
- {****************************************************************************
-
- Copyright (c) 1993,96 by Florian Klämpfl
-
- ****************************************************************************}
-
- { Unit System für DOS-Extender von DJ Delorie }
- {$define DOS}
- unit system;
-
- interface
-
- { die betriebssystemunabhangigen Deklarationen einfuegen: }
-
- {$I SYSTEMH.INC}
-
- {$I HEAPH.INC}
-
- implementation
-
- { die betriebssystemunabhängigen Implementationen einfuegen: }
-
- {$I SYSTEM.INC}
-
- type
- plongint = ^longint;
-
- procedure halt;
-
- begin
- asm
- movl $0x4c00,%eax
- int $0x21
- end;
- end;
-
- procedure halt(errnum : byte);
-
- begin
- do_exit;
- asm
- movl $0x4c00,%eax
- movb 8(%ebp),%al
- int $0x21
- end;
- end;
-
- function paramcount : longint;
-
- begin
- asm
- movl _argc,%eax
- decl %eax
- leave
- ret
- end ['EAX'];
- end;
-
- function paramstr(l : longint) : string;
-
- function args : pointer;
-
- begin
- asm
- movl _args,%eax
- leave
- ret
- end ['EAX'];
- end;
-
- var
- p : ^pchar;
-
- begin
- if (l>=0) and (l<=paramcount) then
- begin
- p:=args;
- paramstr:=strpas(p[l]);
- end
- else paramstr:='';
- end;
-
- procedure randomize;
-
- var
- hl : longint;
-
- begin
- asm
- movb $0x2c,%ah
- int $0x21
- movw %cx,-4(%ebp)
- movw %dx,-2(%ebp)
- end;
- randseed:=hl;
- end;
-
- { use standard heap management }
- {$I HEAP.INC}
-
- {****************************************************************************
- Unterprogramme zu Dateiverwaltung
- ****************************************************************************}
-
- procedure do_close(h : longint);
-
- begin
- asm
- movl 8(%ebp),%ebx
- movb $0x3e,%ah
- pushl %ebp
- intl $0x21
- popl %ebp
- end;
- end;
-
- procedure fileclosefunc(var t : textrec);
-
- begin
- do_close(t.handle);
- end;
-
- function open(f : pchar;flags : longint) : longint;
-
- begin
- asm
- movw $0xff02,%ax
- movl 8(%ebp),%ebx
- movl 12(%ebp),%ecx
- int $0x21
- jnc LOPEN1
- movw %ax,U_SYSTEM_INOUTRES;
- xorl %eax,%eax
- LOPEN1:
- // Returnwert ist in EAX
- leave
- ret $8
- end;
- end;
-
- procedure doserase(p : pchar);
-
- begin
- asm
- movl 8(%ebp),%edx
- movb $0x41,%ah
- pushl %ebp
- int $0x21
- popl %ebp
- jnc LERASE1
- movw %ax,U_SYSTEM_INOUTRES;
- LERASE1:
- end;
- end;
-
- procedure dosrename(p1,p2 : pchar);
-
- begin
- asm
- movl 8(%ebp),%edx
- movl 12(%ebp),%edi
- movb $0x56,%ah
- pushl %ebp
- int $0x21
- popl %ebp
- jnc LRENAME1
- movw %ax,U_SYSTEM_INOUTRES;
- LRENAME1:
- end;
- end;
-
- procedure doswrite(h,addr,len : longint);
-
- begin
- asm
- movl 16(%ebp),%ecx
- movl 12(%ebp),%edx
- movl 8(%ebp),%ebx
- movb $0x40,%ah
- int $0x21
- jnc LDOSWRITE1
- movw %ax,U_SYSTEM_INOUTRES;
- LDOSWRITE1:
- end;
- end;
-
- function dosread(h,addr,len : longint) : longint;
-
- begin
- asm
- movl 16(%ebp),%ecx
- movl 12(%ebp),%edx
- movl 8(%ebp),%ebx
- movb $0x3f,%ah
- int $0x21
- jnc LDOSREAD1
- movw %ax,U_SYSTEM_INOUTRES;
- xorl %eax,%eax
- LDOSREAD1:
- leave
- ret $12
- end;
- end;
-
- function dosfilepos(handle : longint) : longint;
-
- begin
- asm
- movb $0x42,%ah
- movb $0x1,%al
- movl 8(%ebp),%ebx
- xorl %ecx,%ecx
- xorl %edx,%edx
- pushl %ebp
- int $0x21
- popl %ebp
- jnc LDOSFILEPOS1
- movw %ax,U_SYSTEM_INOUTRES;
- xorl %eax,%eax
- jmp LDOSFILEPOS2
- LDOSFILEPOS1:
- shll $16,%edx
- movzwl %ax,%eax
- orl %edx,%eax
- LDOSFILEPOS2:
- leave
- ret $4
- end;
- end;
-
- procedure dosseek(handle : longint;pos : longint);
-
- begin
- asm
- movb $0x42,%ah
- xorb %al,%al
- movl 8(%ebp),%ebx
- movl 12(%ebp),%edx
- // ginge auch mit SHLD
- movl %edx,%ecx
- shrl $16,%ecx
- pushl %ebp
- int $0x21
- popl %ebp
- jnc LDOSSEEK1
- movw %ax,U_SYSTEM_INOUTRES;
- LDOSSEEK1:
- end;
- end;
-
- function dosfilesize(handle : longint) : longint;
-
- function set_at_end(handle : longint) : longint;
-
- begin
- asm
- movb $0x42,%ah
- movb $0x2,%al
- // Vorsicht Stack: 0 %ebp; 4 retaddr;
- // 8 nextstackframe; 12 handle
- movl 12(%ebp),%ebx
- xorl %ecx,%ecx
- xorl %edx,%edx
- pushl %ebp
- int $0x21
- popl %ebp
- jnc Lset_at_end1
- movw %ax,U_SYSTEM_INOUTRES;
- xorl %eax,%eax
- jmp Lset_at_end2
- Lset_at_end1:
- shll $16,%edx
- movzwl %ax,%eax
- orl %edx,%eax
- Lset_at_end2:
- leave
- ret $8
- end;
- end;
-
- var
- tempfilesize : longint;
- aktfilepos : longint;
-
- begin
- aktfilepos:=dosfilepos(handle);
- tempfilesize:=set_at_end(handle);
- dosseek(handle,aktfilepos);
- dosfilesize:=tempfilesize;
- end;
-
- procedure fileopenfunc(var f : textrec);
-
- var
- b : array[0..255] of char;
-
- begin
- move(f.name[1],b,length(f.name));
- b[length(f.name)]:=#0;
- f.inoutfunc:=@fileinoutfunc;
- f.flushfunc:=@fileinoutfunc;
- f.closefunc:=@fileclosefunc;
- case f.mode of
- fminput : f.handle:=open(b,$8001);
- fmoutput : f.handle:=open(b,$8302);
- end;
- end;
-
- function eof(var t : text) : boolean;[iocheck];
-
- begin
- eof:=dosfilesize(textrec(t).handle)<=dosfilepos(textrec(t).handle);
- if eof then
- eof:=textrec(t).bufend<=textrec(t).bufpos;
- end;
-
- procedure rewrite(var f : file;l : word);[iocheck];
-
- var
- b : array[0..255] of char;
-
- begin
- filerec(f).mode:=fmoutput;
- move(filerec(f).name[1],b,length(filerec(f).name));
- b[length(filerec(f).name)]:=#0;
- filerec(f).handle:=open(b,$8302);
- filerec(f).recsize:=l;
- end;
-
- procedure reset(var f : file;l : word);[iocheck];
-
- var
- b : array[0..255] of char;
-
- begin
- move(filerec(f).name[1],b,length(filerec(f).name));
- b[length(filerec(f).name)]:=#0;
- {
- filerec(f).mode:=fminput;
- filerec(f).handle:=open(b,$8001);
- }
- case filemode of
- 0 : begin
- filerec(f).mode:=fminput;
- filerec(f).handle:=open(b,$8001);
- end;
- 1 : begin
- filerec(f).mode:=fmoutput;
- filerec(f).handle:=open(b,$8302);
- end;
- 2 : begin
- filerec(f).mode:=fminout;
- filerec(f).handle:=open(b,$8404);
- end;
- end;
- filerec(f).recsize:=l;
- end;
-
- procedure rewrite(var f : file);[iocheck];
-
- begin
- rewrite(f,128);
- end;
-
- procedure reset(var f : file);[iocheck];
-
- begin
- reset(f,128);
- end;
-
- procedure blockwrite(var f : file;var buf;count : longint);[iocheck];
-
- var
- p : pointer;
- size : longint;
-
- begin
- p:=@buf;
- doswrite(filerec(f).handle,longint(p),count*filerec(f).recsize);
- end;
-
- procedure blockread(var f : file;var buf;count : longint;var result : longint);[iocheck];
-
- begin
- result:=dosread(filerec(f).handle,longint(@buf),
- count*filerec(f).recsize) div filerec(f).recsize;
- end;
-
- procedure blockread(var f : file;var buf;count : longint);[iocheck];
-
- var
- result : longint;
-
- begin
- blockread(f,buf,count,result);
- end;
-
- function filepos(var f : file) : longint;[iocheck];
-
- begin
- filepos:=dosfilepos(filerec(f).handle) div filerec(f).recsize;
- end;
-
- function filesize(var f : file) : longint;[iocheck];
-
- begin
- filesize:=dosfilesize(filerec(f).handle) div filerec(f).recsize;
- end;
-
- function eof(var f : file) : boolean;[iocheck];
-
- begin
- eof:=filesize(f)<=filepos(f);
- end;
-
- procedure seek(var f : file;pos : longint);[iocheck];
-
- begin
- dosseek(filerec(f).handle,pos*filerec(f).recsize);
- end;
-
- procedure close(var f : file);[iocheck];
-
- begin
- if (filerec(f).mode<>fmclosed) then
- begin
- filerec(f).mode:=fmclosed;
- do_close(filerec(f).handle);
- end;
- end;
-
- procedure dos_dirs(func : byte;name : pchar);
-
- begin
- asm
- movl 10(%ebp),%edx
- movb 8(%ebp),%ah
- int $0x21
- jnc LDOS_DIRS1
- movw %ax,U_SYSTEM_INOUTRES;
- LDOS_DIRS1:
- leave
- ret $6
- end;
- end;
-
- procedure _dir(func : byte;const s : string);
-
- var
- buffer : array[0..255] of char;
-
- begin
- move(s[1],buffer,length(s));
- buffer[length(s)]:=#0;
- dos_dirs(func,buffer);
- end;
-
- procedure mkdir(const s : string);
-
- begin
- _dir($39,s);
- end;
-
- procedure rmdir(const s : string);
-
- begin
- _dir($3a,s);
- end;
-
- procedure chdir(const s : string);
-
- begin
- _dir($3b,s);
- end;
-
- { thanks to Michael Van Canneyt <michael@tfdec1.fys.kuleuven.ac.be>, }
- { who writes this code }
- procedure getdir(drivenr : byte;var dir : string);
-
- var
- temp : string;
- sof : pointer;
- i : byte;
-
- begin
- sof:=@dir[4];
-
- { dir[1..3] will contain '[drivenr]:\', but is not }
- { supplied by DOS, so we let dos string start at }
- { dir[4] }
- asm
- { Get dir from drivenr : 0=default, 1=A etc... }
- movb drivenr,%dl
-
- { put (previously saved) offset in si }
- movl sof,%esi
-
- { call msdos function 47H : Get dir }
- mov $0x47,%ah
-
- { make the call }
- int $0x21
-
- { Rem: if call unsuccesfull, carry is set, and AX has }
- { error code }
-
-
- end;
- { Now Dir should be filled with directory in ASCIIZ, }
- { starting from dir[4] }
- dir[0]:=#3;
- dir[2]:=':';
- dir[3]:='\';
-
- i:=4;
-
- { conversation to Pascal string }
- while (dir[i]<>#0) do
- begin
- { convert path name to DOS }
- if dir[i]='/' then
- dir[i]:='\';
- dir[0]:=chr(i);
- inc(i);
- end;
- { upcase the string (FPKPascal function) }
- dir:=upcase(dir);
- if drivenr<>0 then { Drive was supplied. We know it }
- dir[1]:=chr(65+drivenr-1)
- else
- begin
- { We need to get the current drive from DOS function 19H }
- { because the drive was the default, which can be unknown }
- asm
- movb $0x19,%ah
- int $0x21
- addb $65,%al
- movb %al,i
- end;
- dir[1]:=chr(i)
- end;
- end;
-
- var
- i : longint;
-
- begin
- exitproc:=nil;
- { Heapmanagement initialisieren }
- {
- for i:=1 to 32 do
- blocks[i]:=nil;
- }
- heaporg:=getheapstart;
- heapptr:=heaporg;
- _memavail:=getheapsize;
- heapend:=heaporg+_memavail;
- heaperror:=nil;
- freelist:=nil;
- { Standartinput initialisieren }
- assign(input,'');
- textrec(input).handle:=0;
- textrec(input).mode:=fminput;
- textrec(input).inoutfunc:=@fileinoutfunc;
- textrec(input).flushfunc:=@fileinoutfunc;
- { Standartoutput initialisieren }
- assign(output,'');
- textrec(output).handle:=1;
- textrec(output).mode:=fmoutput;
- textrec(output).inoutfunc:=@fileinoutfunc;
- textrec(output).flushfunc:=@fileinoutfunc;
- textrec(input).mode:=fminput;
- { kein Ein- Ausgabefehler }
- inoutres:=0;
- end.
-